perm filename IO[G,BGB]4 blob sn#068996 filedate 1974-01-02 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00023 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	TITLE IO - GEM INPUT/OUTPUT - BGB - FEBRUARY 1973.
C00006 00003	SUBR(PLOTO)	DISPLAY BUFFER TO DISK FILE.
C00009 00004	SUBR(TVHELP,FILLOC)	HELP - DISPLAY DOCUMENTATION.
C00012 00005	SUBR(GETFIL,EXT)	SETUP FILE SPEC FROM TTY LINE.
C00014 00006	SUBR(GETCHW)		GET CHARACTER WAIT.
C00017 00007	SUBR(MACCHR)		This routine is experimental
C00019 00008	SUBR(SERIAL,BODY)	SERIAL NUMBER THE ALT LINKS OF A BODY.
C00021 00009	SUBR(OFEV,BODY)		OUTPUT THE FEV OF A BODY.
C00024 00010	SUBR(OUTD3D)		OUTPUT DUMP 3D.
C00025 00011	SUBR(OUTB3D,BODY)	OUTPUT B3D BODY.
C00027 00012	SUBR(ICAM)		INPUT CAMERA.
C00029 00013	SUBR(OCAM)		OUTPUT CAMERA.
C00031 00014	SUBR(FINTEN,IMAGE)	FACE INTENSITY SCAN.
C00034 00015	SUBR(VINTEN,IMAGE)	VERTEX INTENSITY SCAN.
C00037 00016	SUBR(OFORM2)		OUTPUT A TRI FILE FOR MAKVID.
C00039 00017	OFORM2 --- CONTINUED.
C00043 00018	SUBR(IFEV,BODY)		INPUT F.E.V. BLOCKS.
C00051 00019	SUBR(IBODY,BODY0)	INPUT A BODY AND ALL ITS PARTS.
C00053 00020	SUBR(IND3D)		INPUT GEM NODES.
C00055 00021	SUBR(INB3D)		INPUT B3D FORMAT.
C00056 00022	SUBR(IFORM2)		INPUT GEO COMMANDS.
C00057 00023	SUBR(INCRE)		INPUT CRE NODES.
C00059 ENDMK
C⊗;
TITLE IO - GEM INPUT/OUTPUT - BGB - FEBRUARY 1973.

EXTERN MKB,MKF,MKE,MKV,MKFRAME,BATT,FCCW
INTERN MACPTR,MACCNT,MACNOD,FILFLG

	↓CMDCHN←←16
	↓IODEND←20000
	FILNAM:0	;FILE NAME.
	EXTION:0↔0	;EXTENSION.
	PPPN:0		;PROJECT-PROGRAMMER.
	
	OBUF:BLOCK 3	;OUTPUT BUFFER HEADER.
	IBUF:BLOCK 3	;INPUT BUFFER HEADER.
	CMDHDR:	BLOCK 3	;COMMAND BUFFER HEADER
	MACPTR:	0
	MACCNT:	0
	MACNOD:	0	;IF NON-ZERO, ADDRESS OF TEXT NODE
	FILFLG:	0	;COMMAND FILE
	EOF:	0	;END OF FILE FLAG.
	GEMFLG:	0	;KIND OF FILE FORMAT 0 FOR B3D, -1 FOR GEM.
				;+1 FOR GEM CALLED BY SAIL.
	CMDBUF:	BLOCK 2*(201+2)

	BLOCK 3
	BFRAME:BLOCK 9	;BODY FRAME BUFFER.
	
	PCNT:0		;PARTS COUNT.
	FCNT:0		;FACE COUNT.
	ECNT:0		;EDGE COUNT.
	VCNT:0		;VERTEX COUNT.

	PLTFLG↑: 0	;SET DURING PLOT OUTPUT TO DISABLE III KLUDGES

SUBR(WORDO,WORD)	;WORD OUTPUT.
COMMENT ⊗------------------------------------------------------------
⊗
	LAC WORD
	SOSG OBUF+2↔OUT 1,0
	GO[IDPB 0,OBUF+1↔POP1J]
	FATAL(WORDO)
ENDR;2/18/73(BGB)----------------------------------------------------

WORDIN: ;----------------------------------------------------------
BEGIN WORDIN; WORD INPUT TO AC0 - BGB - 18 FEBRUARY 1973.
	SOSG IBUF+2↔IN 1,0
	GO[ILDB 0,IBUF+1↔POP0J]
	STATO 1,1B22↔GO[FATAL(WORDIN)]
	SETOM EOF↔POP0J
BEND;2/18/73(BGB)--------------------------------------------------
SUBR(PLOTO)	;DISPLAY BUFFER TO DISK FILE.
COMMENT ⊗------------------------------------------------------------
⊗
	EXTERN DPYBUF,GEODPY
	SETOM PLTFLG
	CALL(GEODPY)
	SETZM PLTFLG
	CALL(GETFIL,[SIXBIT/PLT/])↔POP0J
	LAC 1,DPYBUF↔LACN(1)1↔SUBI 2
	CDR 2,(1)↔SETZM 1(2)
	MOVS↔LAPI -1(1)↔DAC DUMLST
	INIT 1,17↔SIXBIT/DSK/↔0↔HALT
	ENTER 1,FILNAM↔GO .+4
	OUT 1,DUMLST↔JFCL
	OUTSTR[ASCIZ"	EOF.
"]↔	RELEASE 1,
	POP0J
DUMLST:	0↔0
ENDR PLOTO;12/10/72(BGB)---------------------------------------------

SUBR(IGEM2)
COMMENT ⊗------------------------------------------------------------
⊗↔	SETOM GEMFLG↔CALL(INB3D)↔SETZM GEMFLG↔POP0J
ENDR IGEM2

SUBR(OGEM2,BODY)
COMMENT ⊗------------------------------------------------------------
⊗
	SETOM GEMFLG↔CALL(OUTB3D,BODY)↔SETZM GEMFLG↔POP1J
ENDR OGEM2

IFN SAIL,{
SUBR(IGEM)		
COMMENT ⊗------------------------------------------------------------
SAIL accessible Input GEM file.
⊗↔	
	POP 16,STRING↔POP 16,0↔DAPZ STRCNT
	AOS GEMFLG↔CALL(INB3D)↔SETZM GEMFLG↔POP0J
ENDR IGEM;8/27/73(BGB)-----------------------------------------------

SUBR(OGEM,BODY)
COMMENT ⊗------------------------------------------------------------
SAIL accessible Output GEM file.
⊗
	POP 16,STRING↔POP 16,0↔DAPZ STRCNT
	AOS GEMFLG↔CALL(OUTB3D,BODY)↔SETZM GEMFLG↔POP1J
ENDR OGEM;8/27/73(BGB)-----------------------------------------------
	STRING:0	;STRING BYTE POINTER.
	STRCNT:0	;STRING BYTE COUNT.
}
SUBR(TVHELP,FILLOC)	;HELP - DISPLAY DOCUMENTATION.
COMMENT ⊗------------------------------------------------------------
⊗
	EXTERNAL REALI,JOBREL,JOBFF
	EXTERNAL DPYSET,DPYOUT,DPYBIG,DPYBRT,AIVECT,RIVECT,DTYO,DPYBUF
	SETZM INHDR
	INIT 17,↔SIXBIT/DSK/↔INHDR
	GO [FATAL(CAN'T INIT DSK)]
	LACI 1,2↔HRL 1,FILLOC↔BLT 1,5
	LOOKUP 17,2↔GO[OUTSTR[ASCIZ/HELP FILE NOT FOUND.
/]↔     POP1J ]
	PUSH P,JOBFF↔PUSH P,JOBREL↔LAC 1,JOBREL↔DAC 1,JOBFF
	USETI 17,1↔SETSTS 17,0↔LACI 0,4↔GO PGLOOP-1 ;START 'EM ON PAGE-4.
LOOP:	USETI 17,1↔SETSTS 17,0↔OUTSTR[ASCIZ/PAGE = /]		
	CALL(REALI)↔FIXX↔JUMPE 0,RET↔DAC 0,PAGNUM#
	SOJLE 0,FOUND
PGLOOP:	CALL(GETCHR)↔GO[OUTSTR[ASCIZ/PAGE NOT FOUND.
/]↔     GO RET]
	CAIE 1,14↔GO PGLOOP↔GO PGLOOP-1

FOUND:	CALL(DPYSET,DPYBUF)↔CALL(AIVECT,[0],[=440])
	CALL(DPYBIG,[1])↔CALL(DPYBRT,[1])↔SETZM LPOS#

CHLOOP:	CALL(GETCHR)↔GO FIN
	CAIN 1,14↔GO FIN
	CAIN 1,11↔GO[CALL(DTYO,[40])
	     AOS 1,LPOS↔TRNE 1,7↔GO $.-4↔GO CHLOOP]
	CALL(DTYO,1)↔AOS LPOS↔LAC 1,1(P)
	CAIE 1,15↔GO CHLOOP
	DZM LPOS↔CALL(RIVECT,[1000],[0])
	GO CHLOOP

FIN:	CALL(DPYOUT,[16])↔GO LOOP
RET:	RELEASE 17,↔POP P,JOBFF↔LAC 1,JOBFF
	CORE 1,↔GO[FATAL(CAN'T SHRINK CORE)]
	POP P,JOBFF↔POP1J
GETCHR:	SOSG INHDR+2↔IN 17,
	GO[ILDB 1,INHDR+1↔AOS(P)↔POP0J ]	;SKIP ON CHARACTER.
	POP0J
INHDR:	BLOCK 3
ENDR TVHELP;---------------------------------------------------------
SUBR(GETFIL,EXT)	;SETUP FILE SPEC FROM TTY LINE.
COMMENT ⊗------------------------------------------------------------
⊗
	SETZM FILNAM
	SETZM EXTION
	SETZM EXTION+1
	SETZM PPPN
	SKIPLE GEMFLG↔GO L0			;SKIP PROMPT WHEN SAIL CALL.
	OUTCHR["	"]↔LAC 1,EXT↔JUMPE 1,.+6	;TYPE OUT EXTENSION.
	SETZ↔ROTC 6↔ADDI 40↔OUTCHR↔GO .-5
	OUTSTR[ASCIZ/ FILE = /]
L0:	LAC 1,[POINT 6,FILNAM,-1]↔LACI 2,6
	CALL(GETCL0)↔CAIL"a"↔SUBI 40
	CAIN 15↔GO[INCHWL↔POP1J]↔AOSA(P)

L:	CALL(GETCL0)↔CAIL"a"↔SUBI 40
	CAIN"."↔GO[SETZM ARG1↔LAC 1,[POINT 6,EXTION,-1]↔LACI 2,3↔GO L]
	CAIN"["↔GO[LAC 1,[POINT 6,PPPN,-1]  ↔LACI 2,3↔GO L]
	CAIN","↔GO[LAC 1,[POINT 6,PPPN,17]  ↔LACI 2,3↔GO L]
	CAIN"]"↔GO L

	CAIN 15↔GO EOL			;END OF THE LINE.
	CAIN 12↔GO EOL
	JUMPE EOL	;NULLS.
	CAIG" "↔GO L	;IGNORE GARBAGE.
	SOJL 2,L
	SUBI 40↔IDPB 1↔GO L	;ASCII TO SIXBIT.

EOL:	CALL(GETCL0)
	CAR PPPN
	TRNN 77↔LSH -6↔TRNN 77↔LSH -6    ;RIGHT ADJUST PROJECT.
	DIP PPPN
	CDR PPPN
	TRNN 77↔LSH -6↔TRNN 77↔LSH -6    ;RIGHT ADJUST PROGRAMMER.
	DAP PPPN
	SKIPN 1,EXTION↔LAC 1,ARG1↔DAC 1,EXTION ;DEFAULT EXTENSION.
	POP1J
ENDR GETFIL;2/18/73(BGB)---------------------------------------------
SUBR(GETCHW)		;GET CHARACTER WAIT.
COMMENT ⊗------------------------------------------------------------
⊗
	SETZ 1,
	SKIPN FILFLG↔SKIPE MACNOD
	CALL(MACGET)↔JUMPN 1,[POP0J]
	INCHRW 1
	POP0J
ENDR GETCHW;5/8/73(TVR)----------------------------------------------

SUBR(GETCHL)
COMMENT ⊗------------------------------------------------------------
⊗
	SETZ 1,
	SKIPN FILFLG
	SKIPE MACNOD
	CALL(MACGET)
	JUMPN 1,[POP0J]
	INCHWL 1
	POP0J
ENDR GETCHL;5/8/73(TVR)----------------------------------------------

SUBR(MACGET)
COMMENT ⊗------------------------------------------------------------
⊗
	PUSHP 2↔SETZ 2,
	SKIPE MACNOD↔CALL(MACCHR)
	SKIPE FILFLG↔CALL(FILCHR)
	SETZ 1,
	CAIN 1,"α"↔GO[TRO 2,200↔GO MACGE2]
	CAIN 1,"β"↔GO[TRO 2,400↔GO MACGE2]
	CAIN 1,"ε"↔GO[TRO 2,600↔GO MACGE2]
	JUMPN 2,MACGE2
	CAIN 1,"≡"↔GO MACGE2
MACGE1:	POPP 2↔POP0J
MACGE2:	SKIPE MACNOD↔CALL(MACCHR)
	SKIPE FILFLG↔CALL(FILCHR)
	SETZ 1,↔OR 1,2
	GO MACGE1
ENDR MACGET;5/8/73(TVR)----------------------------------------------

SUBR(FILCHR)		;GET FILE CHARACTER & SKIP.
COMMENT ⊗------------------------------------------------------------
⊗
	SOSG CMDHDR+2↔IN CMDCHN,
	GO[ILDB 1,CMDHDR+1↔JUMPE 1,FILCHR↔AOS(P)↔POP0J ]
	STATO CMDCHN,IODEND↔FATAL(READ ERROR IN COMMAND FILE)
	RELEASE CMDCHN,
	OUTSTR[ASCIZ/<COMMAND FILE EOF>/]
	SETZM FILFLG↔POP0J
ENDR FILCHR;5/8/73(TVR)----------------------------------------------
SUBR(MACCHR)		;This routine is experimental
COMMENT ⊗------------------------------------------------------------
⊗
	LACI 1,3↔ADDM 1,(P)
MCLOOP:	SOSLE MACCNT
	GO [ ILDB 1,MACPTR
	     JUMPE 1,MCLOOP
	     POP0J ]
	MOVE 1,MACNOD
	TCCW 1,1
	SKIPN 1↔OUTSTR[ASCIZ/<LEAVING MACRO>
/]↔	DAC 1,MACNOD
	LIPI 1,000700
	DAC 1,MACPTR
	LACI 1,5*8-1↔DAC 1,MACCNT
	MOVEI 1,15
	POP0J
ENDR MACCHR;5/12/73(TVR)---------------------------------------------

;THE FOLLOW CROCK HAS BEEN INTRODUCED IN THE INTEREST OF EASIER CONVERSION
SUBR(GETCL0)
	IFN SAIL,{SKIPG GEMFLG↔GO .+5		;FETCH CHR FROM SAIL STRING.
	SETZ↔SOSL STRCNT↔ILDB STRING↔POP0J}
	LAC 0,1		;SAVE AC.0
	CALL(GETCHL)
	EXCH 0,1
	POP0J
ENDR GETCL0;(TVR)

SUBR(GETCW0)
	LAC 0,1		;SAVE AC.0
	CALL(GETCHW)
	EXCH 0,1
	POP0J
ENDR GETCW0;(TVR)
SUBR(SERIAL,BODY)	;SERIAL NUMBER THE ALT LINKS OF A BODY.
COMMENT ⊗------------------------------------------------------------
⊗
	LAC 1,BODY↔TEST 1,BBIT↔POP1J

;COUNT FACES, EDGES, AND VERTICES.
	LACI 1↔PFACE 1,1↔ALT. 0,1↔CAME 1,ARG1↔AOJA .-3↔SOS↔DAC FCNT
	LACI 1↔PED   1,1↔ALT. 0,1↔CAME 1,ARG1↔AOJA .-3↔SOS↔DAC ECNT
	LACI 1↔PVT   1,1↔ALT. 0,1↔CAME 1,ARG1↔AOJA .-3↔SOS↔DAC VCNT

;COUNT PARTS.
	SETZ↔SON 1,1↔DAC 1,2↔JUMPE 1,.+5↔AOS
	BRO 2,2↔CAME 1,2↔AOJA .-2
	DAC PCNT

;OUTPUT BODY HEADER.
	CALL(WORDO,PCNT)
	CALL(WORDO,FCNT)
	CALL(WORDO,ECNT)
	CALL(WORDO,VCNT)
	LAC 1,ARG1
	CALL(WORDO,{-2(1)})	;PNAME.
	CALL(WORDO,{-1(1)})	;PNAME.
	SKIPN GEMFLG↔GO L0
	CALL(WORDO,{0(1)})	;BODY TYPE BITS.
	CALL(WORDO,{8(1)})	;USER'S BODY WORD.

;BODIES LOCATION ORIENTATION MATRIX.
L0:	FRAME 1,1↔SKIPN 1↔LACI 1,L2		;BODY'S FRAME OR EMPTY.
	LACI 2,=12↔SUBI 1,3
L1:	CALL(WORDO,{(1)})↔AOS 1↔SOJG 2,L1
	POP1J
	BLOCK 3		;EMPTY FRAME.
L2:	BLOCK 9
ENDR SERIAL;2/18/73(BGB)---------------------------------------------
SUBR(OFEV,BODY)		;OUTPUT THE FEV OF A BODY.
COMMENT ⊗------------------------------------------------------------
⊗
	LAC 1,BODY
L1:	PFACE 1,1↔CAMN 1,ARG1↔GO L2
	CALL(WORDO,{4(1)})	;FIRST FACE DATA WORD  -  REFLECTIVITIES.
	CALL(WORDO,{5(1)})	;SECOND FACE DATA WORD -  ILLUMINOUSITIES.
	SKIPN GEMFLG↔GO L1
	CALL(WORDO,{0(1)})	;FACE TYPE BITS.
	CALL(WORDO,{8(1)})	;USER'S FACE WORD.
	GO L1

L2:	PED 1,1↔CAMN 1,ARG1↔GO L3	;OUTPUT EDGE NODES.
	NFACE 2,1↔ALT 2,2↔DIP 2,0
	PFACE 2,1↔ALT 2,2↔DAP 2,0↔CALL(WORDO,0)
	NVT   2,1↔ALT 2,2↔DIP 2,0
	PVT   2,1↔ALT 2,2↔DAP 2,0↔CALL(WORDO,0)
	NCW   2,1↔ALT 2,2↔DIP 2,0
	PCW   2,1↔ALT 2,2↔DAP 2,0↔CALL(WORDO,0)
	NCCW  2,1↔ALT 2,2↔DIP 2,0
	PCCW  2,1↔ALT 2,2↔DAP 2,0↔CALL(WORDO,0)
	SKIPN GEMFLG↔GO L2
	CALL(WORDO,{0(1)})	;EDGE TYPE BITS.
	CALL(WORDO,{8(1)})	;USERS EDGE WORD.
	GO L2

L3:	PVT 1,1↔CAMN 1,ARG1↔POP1J	;OUTPUT VERTEX NODES.
	CALL(WORDO,{XWC(1)})
	CALL(WORDO,{YWC(1)})
	CALL(WORDO,{ZWC(1)})
	SKIPN GEMFLG↔GO L3
	CALL(WORDO,{0(1)})	;VERTEX TYPE BITS.
	CALL(WORDO,{8(1)})	;USERS VERTEX WORD.
	GO L3
ENDR OFEV;2/18/73(BGB)-----------------------------------------------

SUBR(OBODY,BODY)	;OUTPUT BODY AND ITS PARTS.
COMMENT ⊗------------------------------------------------------------
⊗
	ACCUMULATORS{N,B}
	CALL(SERIAL,BODY)		;SERIAL NUMBER THE F.E.V.
	CALL(OFEV,BODY)			;OUTPUT THE F.E.V.
	LAC B,BODY
	SON N,B↔JUMPE N,L2		;EXIT - AIN'T GOT NO PARTS.
L1:	PUSHP N↔CALL(OBODY,N)		;RECURSE - ON SUB PARTS.
	POPP N↔LAC B,BODY
	BRO N,N↔SON 0,B
	CAME 0,N↔GO L1
L2:	POP1J

ENDR OBODY;2/18/73(BGB)----------------------------------------------
SUBR(OUTD3D)		;OUTPUT DUMP 3D.
COMMENT ⊗------------------------------------------------------------
⊗
	EXTERN UNIVERSE,COMPAC
	ACCUMULATORS{U}
L1:	CALL(GETFIL,[SIXBIT/D3D/])↔POP0J
	INIT 1,17↔SIXBIT/DSK/↔XWD OBUF,0↔HALT
	ENTER 1,FILNAM↔GO[
		RELEASE 1,
		OUTSTR[ASCIZ/ ENTER FAILED./]
		CRLF↔POP0J]
	CALL(COMPACT)
	LAC U,UNIVERSE
	LACI 0,-3(U)
	DAPZ 0,1(U)		;SET RELOCATION CONSTANT
	SOS 0
	LACN 1,44
	ADD 1,0
	LIPI 0,(1)
	SETZ 1,
	OUT 1,0↔JRST L2
	FATAL<WRITE ERROR!> ]
L2:	RELEASE 1,↔OUTSTR[ASCIZ/	EOF.
*/]↔	POP0J
ENDR OUTD3D;2/18/73(TVR)---------------------------------------------
SUBR(OUTB3D,BODY)	;OUTPUT B3D BODY.
COMMENT ⊗------------------------------------------------------------
⊗
	EXTERN DPYBUF
	LAC 1,BODY↔TEST 1,BBIT↔POP1J			;BODIES ONLY.
	SLACI'GEM'↔SKIPN GEMFLG↔SLACI'B3D'		;GEM OR B3D.
L1:	CALL(GETFIL,0)↔POP1J				;GET FILE NAME.
	INIT 1,10↔SIXBIT/DSK/↔XWD OBUF,0↔HALT
	ENTER 1,FILNAM↔GO[RELEASE 1,
		OUTSTR[ASCIZ/ ENTER FAILED./]
		CRLF↔POP1J]

;SETUP OUTPUT BUFFERS.
	PUSHP 121			;SAVE.
	LAC DPYBUF↔ADDI 20↔DAC 121
	OUTBUF 1,

;OUTPUT TRANSFER.
	CALL(OBODY,BODY)

;END OF FILE.
	RELEASE 1,
	SKIPG GEMFLG↔OUTSTR[ASCIZ/	EOF./]
	POPP 121↔POP1J			;RESTORE.
ENDR OUTB3D;2/18/73(BGB)---------------------------------------------
SUBR(ICAM)		;INPUT CAMERA.
COMMENT ⊗------------------------------------------------------------
⊗
	C←←10↔R←←11	;CAMERA & FRAME.
	TDZA 1,1
L1:	RELEASE 1,↔CALL(GETFIL,[SIXBIT/CAM/])↔GO[SETZ 1,↔POP0J]
	INIT 1,10↔SIXBIT/DSK/↔IBUF↔HALT
	LOOKUP 1,FILNAM↔GO L1
	PUSH P,121↔LAC DPYBUF↔ADDI 20↔DAC 121↔INBUF 1,
;FETCH NOW CAMERA.
	LAC C,UNIVERSE↑↔NWRLD C,C
	NCAMR C,C↔FRAME R,C↔CALL(KLNODE↑,R)

;INPUT TRANSFER.
	CALL(WORDIN)↔FMPR FEET↔PUSH P,0	;CX
	CALL(WORDIN)↔FMPR FEET↔PUSH P,0	;CY
	CALL(WORDIN)↔FMPR FEET↔PUSH P,0	;CZ

	CALL(WORDIN)↔PUSH P,0	;PAN
	CALL(WORDIN)↔PUSH P,0	;TILT
	CALL(WORDIN)↔PUSH P,0	;SWING

	CALL(MKROT1↑)↔FRAME. 1,C
	POP P,ZWC(1)↔POP P,YWC(1)↔POP P,XWC(1)
	CALL(WORDIN)↔FMPR FEET↔DAC 1(C)		;PDX
	CALL(WORDIN)↔FMPR FEET↔DAC 2(C)		;PDY
	CALL(WORDIN)↔FMPR FEET↔DAC 3(C)		;PDZ
	CALL(WORDIN)↔FMPR FEET↔DAC 1		;FOCAL
	LACN 1↔FDVR 1(C)↔DAC -3(C)	;SCALEX
	LACN 1↔FDVR 2(C)↔DAC -2(C)	;SCALEY
	LACN 1↔FDVR 3(C)↔DAC -1(C)	;SCALEZ
	DAC  1,3(C)		;FOCAL

;END OF FILE.
	RELEASE 1,↔POP P,121
	OUTSTR[ASCIZ/	EOF.
*/]↔	POP0J↔FEET:3.280833	;FEET PER METER.
ENDR ICAM;2/21/73(BGB)-----------------------------------------------

SUBR(OCAM)		;OUTPUT CAMERA.
COMMENT ⊗------------------------------------------------------------
⊗
	EXTERN DPYBUF,CAMERA
	C←←10↔R←←11	;CAMERA & FRAME.
L1:	CALL(GETFIL,[SIXBIT/CAM/])↔POP0J
	INIT 1,10↔SIXBIT/DSK/↔XWD OBUF,0↔HALT
	ENTER 1,FILNAM↔GO[RELEASE 1,
	OUTSTR[ASCIZ/ ENTER FAILED./]↔CRLF↔POP0J]
	PUSH P,121↔LAC DPYBUF↔ADDI 20↔DAC 121↔OUTBUF 1,
;FETCH NOW CAMERA.
	LAC 1,UNIVERSE↑↔NWRLD 1,1
	NCAMR C,1↔FRAME R,C
;OUTPUT TRANSFER.
	LAC -3(R)↔FMPR METERS↔CALL(WORDO,0)	;CX
	LAC -2(R)↔FMPR METERS↔CALL(WORDO,0)	;CY
	LAC -1(R)↔FMPR METERS↔CALL(WORDO,0)	;CZ
	SETQ(TILT,{ACOS↑,{KZ(R)}})↔LACN KY(R)	;TILT ← ACOS(KZ).
	SETQ(PAN,{ATAN2↑,{KX(R)},0})		;PAN  ← ATAN2(KX,-KY).
	CALL(SIN↑,TILT)↔LAC JZ(R)
	JUMPE 1,.+4↔FDVR 0,1
	SETQ(SWING,{ACOS↑,0})			;SWING ← ACOS(JZ/SIN(TILT))
	CALL(WORDO,PAN)
	CALL(WORDO,TILT)
	CALL(WORDO,SWING)
	LAC 1(C)↔FMPR METERS↔CALL(WORDO,0)	;PDX
	LAC 2(C)↔FMPR METERS↔CALL(WORDO,0)	;PDY
	LAC 2(C)↔FMPR METERS↔CALL(WORDO,0)	;PDZ
	LAC 3(C)↔FMPR METERS↔CALL(WORDO,0)	;FOCAL
	RELEASE 1,↔OUTSTR[ASCIZ/	EOF.
*/]↔	POP P,121↔POP0J
DECLARE{PAN,TILT,SWING}
METERS:	0.3048006		;FEET/METER.
ENDR OCAM;2/18/73----------------------------------------------------
SUBR(FINTEN,IMAGE);	FACE INTENSITY SCAN.
COMMENT ⊗------------------------------------------------------------
⊗
	ACCUMULATORS{F,B}

;COMPUTE INTENSITIES FOR ALL THE FACES OF THE SIMAGE.
	LAC B,IMAGE↔CCW B,B
	LAC F,B↔PFACE F,F		;STEP OVER BGND FACE.
L0:	PFACE F,F↔CAMN F,B↔POP1J

;FETCH PHOTOMETRIC PARAMETERS OF THE FACE.
	SKIPN 1,4(F)↔WAC 1,↔DAC 1,WORD4
	SKIPN 1,5(F)↔LAC 1,[010101010000]↔DAC 1,WORD5

;DOT FACE NORMAL INTO SUN RAY FOR INCIDENT POWER.
	LAC 0,AA(F)↔FMPR 0,AASUN
	LAC 1,BB(F)↔FMPR 1,BBSUN↔FADR 0,1
	LAC 1,CC(F)↔FMPR 1,CCSUN↔FADR 0,1
	FMPR 0,SOLAR

;REFLECTED INTENSITIES.
L2:	LDB 1,[POINT 9,WORD4,35]
	FSC 1,222↔FMPR 1,0		;REFLECTED POWER IN AC1.

	LDB[POINT 9,WORD4,8]↔FSC 222
	FMPR 1↔FIXX↔DPB[POINT 9,INTEN,8]	;RED.

	LDB[POINT 9,WORD4,17]↔FSC 222
	FMPR 1↔FIXX↔DPB[POINT 9,INTEN,17]	;GREEN.

	LDB[POINT 9,WORD4,26]↔FSC 222
	FMPR 1↔FIXX↔DPB[POINT 9,INTEN,26]	;BLUE.

	FIXX 1,↔DPB 1,[POINT 9,INTEN,35]	;WHITE.
	LAC INTEN↔DAC QQ(F)
	GO L0

AASUN:	0	;SUN VECTOR IN CAMERA COORDINATES.
BBSUN:	0
CCSUN:	-1.0
SOLAR:	512.0	;PSEUDO SOLAR CONSTANT.
WORD4:	0	;REFLECTIVITIES.
WORD5:	0	;LUMINOSITIES.
INTEN:	0	;FINAL INTENSITY BYTES: (RED,GRN,BLU,WHT).
ENDR FINTEN;8/7/73(BGB)----------------------------------------------
;MACROS FOR ACCESSING INTENSITY CCW FROM E ABOUT V.

DEFINE ICCW(E,V){↔PVT 1,E↔CAME 1,V↔SKIPA 1,8(E)↔LAC 1,6(E)}
DEFINE ICCW.(Q,E,V){↔PVT 0,E↔CAME 0,V↔DAC Q,8(E)↔CAMN 0,V↔DAC Q,6(E)}

SUBR(VINTEN,IMAGE);	VERTEX INTENSITY SCAN.
COMMENT ⊗------------------------------------------------------------
Compute intensities for all the edges of the SIMAGE by
going around each vertex averaging face intensities
across NSHARP & ¬FOLDED edges.
⊗
	ACCUMULATORS{F,E,V,CNT,RED,GRN,WHT,BLU,E0,B}
	LAC B,IMAGE↔CCW B,B↔LAC V,B
L0:	PVT V,V↔CAMN V,B↔POP1J
;SCAN FOR THE FIRST FOLD (OR ¬SHARP) OF THIS VERTEX (IF ANY).
	PED E,V↔DAC E,E0
L1:	TESTZ E,FOLDED↔GO L2	;SKIP EDGE NOT FOLDED.
	TEST   ,NSHARP↔GO L2	;SKIP EDGE NOT SHARP.
	SETQ(E,{ECCW,E,V})
	CAME E,E0↔GO L1

L2:	DAC E,E0↔DZM CNT↔DZM WHT	;E0←E; CLEAR FACE COUNT.
	DZM RED↔DZM GRN↔DZM BLU		;CLEAR THE COLOR ACCUMULATORS.

L3:	SETQ(F,{FCCW,E,V})
    ;	CAMN F,BGND↔GO L..
	AOS CNT↔PUSH P,E		;COUNT EDGE & SAVE EDGE.

;ACCUMULATE FACE'S COLORS & INTENSITY.
	LAC 1,7(F)
	ZAC↔ROTC 9↔ADDM RED
	ZAC↔ROTC 9↔ADDM GRN
	ZAC↔ROTC 9↔ADDM BLU
	ZAC↔ROTC 9↔ADDM WHT

	SETQ(E,{ECCW,E,V})
	TESTZ E,FOLDED↔GO L4
	TEST   ,NSHARP↔GO L4
	CAME E,E0↔GO L3

;AVERAGE THE FACE INTENSITIES - AND PLACE AVERAGES INTO EDGES.

L4:	LAC 1,RED↔IDIV 1,CNT↔ROTC -9	;CLOBBERS AC-2.
	LAC 1,GRN↔IDIV 1,CNT↔ROTC -9
	LAC 1,BLU↔IDIV 1,CNT↔ROTC -9
	LAC 1,WHT↔IDIV 1,CNT↔ROTC -9↔LAC 1,0
L5:	POP P,2↔ICCW.(1,2,V)↔SOJG CNT,L5	;"INTENSIFY" EDGE.
	CAME E,E0↔GO L2+1↔GO L0

ENDR VINTEN;8/7/73(BGB)----------------------------------------------
SUBR(OFORM2)		;OUTPUT A TRI FILE FOR MAKVID.
COMMENT ⊗------------------------------------------------------------
⊗	
	ACCUMULATORS{F,E1,E2,E3,V1,V2,V3}
	EXTERN VCW,VCCW,ECW,ECCW

;PICK UP ARGUMENTS.
	LAC 1,UNIVERSE↑
	NWRLD 1,1↔DAC 1,WORLD#		;"NOW" WORLD.
	NCAMR 1,1↔DAC 1,CAMER#		;"NOW" CAMERA.
	SIMAG 1,1↔DAC 1,IMAGE#
	JUMPE 1,[POP0J]			;SYNTHETIC IMAGE.
	CCW 1,1↔DAC 1,BODY#		;BODY OF THE IMAGE.

;SUB DIVIDE ALL THE FACES OF THE IMAGE INTO TRIANGLES.
	LAC 1,BODY#↔PFACE 1,1
L1:	PFACE 1,1↔CAMN 1,BODY↔GO L2
	PUSH P,1↔CALL(MKCVEX↑,1)
	POP P,1↔GO L1

L2:	CALL(FINTEN,IMAGE)
	CALL(VINTEN,IMAGE)

;INITIALIZE BUFFERED DISK OUTPUT.
	CALL(GETFIL,[SIXBIT/TRI/])↔POP0J
	INIT 1,10↔SIXBIT/DSK/↔XWD OBUF,0↔HALT
	ENTER 1,FILNAM↔GO[RELEASE 1,
	OUTSTR[ASCIZ/ ENTER FAILED./]↔CRLF↔POP0J]
	PUSH P,121↔LAC DPYBUF↑↔ADDI 20
	DAC 121↔OUTBUF 1,

;OUTPUT FILE HEADER.
	CALL(WORDO,[=216])	;ROWS.
	CALL(WORDO,[=288])	;COLUMNS.
	CALL(WORDO,[6])		;BITS PER PIXEL.
;OFORM2 --- CONTINUED.

	LAC F,BODY↔PFACE F,F
L3:	PFACE F,F↔CAMN F,BODY↔GO L4

	PED E1,F
	SETQ(V1,{VCW,E1,F})
	SETQ(V2,{VCCW,E1,F})
	SETQ(E2,{ECCW,E1,F})
	SETQ(V3,{VCCW,E2,F})
	SETQ(E3,{ECCW,E2,F})

	LAC 0,XPP(V1)↔FADR 0,[144.0]↔FIX 0,225000	;COLUMN.
	LAC 1,[108.0]↔FSBR 1,YPP(V1)↔FIX 1,225000	;ROW.
	DIP 1,0↔CALL(WORDO,0)
	ICCW(E1,V1)↔CALL(WORDO,1)

	LAC 0,XPP(V2)↔FADR 0,[144.0]↔FIX 0,225000	;COLUMN.
	LAC 1,[108.0]↔FSBR 1,YPP(V2)↔FIX 1,225000	;ROW.
	DIP 1,0↔CALL(WORDO,0)
	ICCW(E2,V2)↔CALL(WORDO,1)

	LAC 0,XPP(V3)↔FADR 0,[144.0]↔FIX 0,225000	;COLUMN.
	LAC 1,[108.0]↔FSBR 1,YPP(V3)↔FIX 1,225000	;ROW.
	DIP 1,0↔CALL(WORDO,0)
	ICCW(E3,V3)↔CALL(WORDO,1)

	GO L3

;END OF FILE.
L4:	CALL(WORDO,[-1])		;END OF TRIANGLES LIST.
	RELEASE 1,↔OUTSTR[ASCIZ/	EOF.
*/]↔	POP P,121↔POP0J
ENDR OFORM2;7/3/73(BGB)----------------------------------------------

SUBR(IFEV,BODY)		;INPUT F.E.V. BLOCKS.
COMMENT ⊗------------------------------------------------------------
⊗
	ACCUMULATORS{F,E,V,A,I,J,FACE,EDGE,VERTEX}

;SETUP BASE POINTER TO SERIAL TABLES.
	SLACI I↔LAP 121
	DAC FACE↔DAC EDGE↔DAC VERTEX
	ADD VERTEX,FCNT
	
;MAKE AND INPUT FACES.
	LACI I,1
L1:	CALL(MKF,ARG1)↔DAC 1,@FACE
	CALL(WORDIN)↔DAC 4(1)		;FACE REFLECTIVITY.
	CALL(WORDIN)↔DAC 5(1)		;FACE LUMENOSITY.
	SKIPN GEMFLG↔GO L1A
	CALL(WORDIN)↔DAC 0(1)		;FACE TYPE BITS.
	CALL(WORDIN)↔DAC 8(1)		;FACE USER WORD.
L1A:	CAME I,FCNT↔AOJA I,L1

;MAKE AND INPUT EDGES.
	LACI I,1
L2:	CALL(MKE,ARG1)↔DIP 1,@EDGE
	CALL(WORDIN)↔DAC 1(1)		;EDGE'S WINGS.
	CALL(WORDIN)↔DAC 3(1)
	CALL(WORDIN)↔DAC 4(1)
	CALL(WORDIN)↔DAC 5(1)
	SKIPN GEMFLG↔GO L2A
	CALL(WORDIN)↔DAC 0(1)		;EDGE TYPE BITS.
	CALL(WORDIN)↔DAC 8(1)		;EDGE USER WORD.
L2A:	CAME I,ECNT↔AOJA I,L2

;MAKE AND INPUT VERTICES.
	LACI I,1
L3:	CALL(MKV,ARG1)↔DAP 1,@VERTEX
	CALL(WORDIN)↔DAC XWC(1)		;VERTEX WORLD LOCUS.
	CALL(WORDIN)↔DAC YWC(1)
	CALL(WORDIN)↔DAC ZWC(1)
	SKIPN GEMFLG↔GO L3A
	CALL(WORDIN)↔DAC 0(1)		;VERTEX TYPE BITS.
	CALL(WORDIN)↔DAC 8(1)		;VERTEX USER WORD.
L3A:	CAME I,VCNT↔AOJA I,L3

;CONVERT SERIAL NUMBERS TO NODE ADDRESSES.
	LACI J,1
L4:	LAC I,J↔CAR E,@EDGE

	NFACE I,E↔CDR F,@FACE↔NFACE. F,E↔PED. E,F
	PFACE I,E↔CDR F,@FACE↔PFACE. F,E↔PED. E,F
	NVT I,E↔CDR V,@VERTEX↔NVT. V,E↔PED. E,V
	PVT I,E↔CDR V,@VERTEX↔PVT. V,E↔PED. E,V
	NCW I,E↔CAR A,@EDGE↔NCW. A,E
	PCW I,E↔CAR A,@EDGE↔PCW. A,E
	NCCW I,E↔CAR A,@EDGE↔NCCW. A,E
	PCCW I,E↔CAR A,@EDGE↔PCCW. A,E
	CAME J,ECNT↔AOJA J,L4↔POP1J
ENDR IFEV;2/18/73(BGB)-----------------------------------------------
SUBR(IBODY,BODY0)	;INPUT A BODY AND ALL ITS PARTS.
COMMENT ⊗------------------------------------------------------------
⊗
	ACCUMULATORS{N,B,B0}

;INPUT BODY HEADER.

	CALL(WORDIN)↔DAC PCNT
	CALL(WORDIN)↔DAC FCNT
	CALL(WORDIN)↔DAC ECNT
	CALL(WORDIN)↔DAC VCNT

;INPUT THE FEV SHELL OF THIS BODY.

	SETQ(B1,{MKB,ARG1})
	LAC B0,ARG1
	JUMPN B0,[CALL(BATT,B1,B0)↔GO .+1]
	LAC B,B1
	CALL(WORDIN)↔DAC -2(B)	;PNAME.
	CALL(WORDIN)↔DAC -1(B)	;PNAME.
	SKIPN GEMFLG↔GO L1A
	CALL(WORDIN)↔DAC 0(1)		;BODY TYPE BITS.
	CALL(WORDIN)↔DAC 8(1)		;BODY USER WORD.
L1A:
;INPUT THE LOCATION ORIENTATION OF THIS BODY.

	LACI 1,BFRAME-3↔LACI 2,=12↔SETZ 4,
L1:	CALL(WORDIN)↔DAC(1)↔IORM 4↔AOS 1↔SOJG 2,L1
	SKIPE 1,4↔CALL(MKFRAME)
	FRAME. 1,B↔JUMPE 1,.+4
	SLACI BFRAME-3↔LAPI XWC(1)↔BLT KZ(1)
	CALL(IFEV,B)
	LAC B,B1↔SKIPN ARG1↔DAC B,ARG1 ;RETURN VALUE TO TOP LEVEL.

;INPUT THE PARTS OF THIS BODY.
L2:	SOSGE PCNT↔POP0J
	PUSH P,PCNT↔PUSH P,B
	CALL(IBODY)
	POP P,B↔POP P,PCNT↔GO L2
B1:0
ENDR IBODY;2/18/73(BGB)----------------------------------------------
SUBR(IND3D)		;INPUT GEM NODES.
COMMENT ⊗------------------------------------------------------------
⊗
	EXTERN UNIVERSE,RELOCATE,INVALID
L1:	CALL(GETFIL,[SIXBIT/D3D/])↔POP0J
	INIT 1,17↔SIXBIT/DSK/↔XWD OBUF,0↔HALT
	LOOKUP 1,FILNAM↔GO[
		RELEASE 1,
		OUTSTR[ASCIZ/ FILE NOT FOUND./]
		CRLF↔POP0J]
	MOVE 0,UNIVERSE
	SUBI 0,4
	HLRE 1,PPPN
	SUBM 0,1
	CORE 1,
	FATAL<NOT ENOUGH CORE FOR DATA STRUCTURE.>
	HLL 0,PPPN
	SETZ 1,
	SETOM INVALID
	IN 1,0
	JRST L2
	FATAL<READ ERROR!> ]
L2:	RELEASE 1,
	MOVE 1,UNIVERS
	SUBI 1,3
	SUB 1,3+1(1)
	JUMPE 1,L3
	CALL(RELOCATE,1)
L3:	OUTSTR[ASCIZ/	EOF.
*/]↔	POP0J
ENDR IND3D;(TVR)-----------------------------------------------------
SUBR(INB3D)		;INPUT B3D FORMAT.
COMMENT ⊗------------------------------------------------------------
⊗
	TDZA 1,1
L1:	RELEASE 1,
	SLACI'GEM'↔SKIPN GEMFLG↔SLACI'B3D'	;GEM OR B3D.
	CALL(GETFIL,0)↔GO[SETZ 1,↔POP0J]
	INIT 1,10↔SIXBIT/DSK/↔IBUF↔HALT
	LOOKUP 1,FILNAM↔GO[
	SKIPG GEMFLG↔GO L1↔RELEASE 1,↔SETZ 1,↔POP0J] ;SAILOR'S LOSE HERE.

;SETUP INPUT BUFFERS.
	PUSHP 121
	LAC DPYBUF↔ADDI 20↔DAC 121
	INBUF 1,

;INPUT TRANSFER.
	CALL(IBODY,[0])↔POP P,1

;END OF FILE.
	RELEASE 1,↔POPP 121
	SKIPG GEMFLG↔OUTSTR[ASCIZ/	EOF./]
	POP0J
ENDR INB3D;2/18/73(BGB)----------------------------------------------
SUBR(IFORM2)		;INPUT GEO COMMANDS.
COMMENT ⊗------------------------------------------------------------
⊗
	TDZA 1,1
L1:	RELEASE CMDCHN,
	CALL(GETFIL,[SIXBIT/GEO/])↔GO[SETZ 1,↔POP0J]
	INIT CMDCHN,0↔SIXBIT/DSK/↔CMDHDR↔HALT
	LOOKUP CMDCHN,FILNAM↔GO L1

;SETUP INPUT BUFFERS.
	PUSH P,121
	LACI CMDBUF↔DAC 121
	INBUF CMDCHN,
	POP P,121
	OUTSTR[ASCIZ/<OPENING COMMAND FILE>
/]↔	SETOM FILFLG
	POP0J
ENDR IFORM2;2/18/73(BGB)---------------------------------------------
SUBR(INCRE)		;INPUT CRE NODES.
COMMENT ⊗------------------------------------------------------------
⊗
;FILE NAME ENTER FROM TTY.
	%←←1B18
L1:	CALL(GETFIL,[SIXBIT/CRE/])↔POP0J
	INIT 1,17↔SIXBIT/DSK/↔0↔HALT
	LOOKUP 1,FILNAM↔GO L1

;DUMP COMMAND WORD.
	LAC PPPN
	LAPI %-1
	DAC INARG

;CREATE UPPER SEGMENT.
	MOVS PPPN↔MOVMS↔ADDI %
	IORI 1777
	CORE2↔HALT

;INPUT TRANSFER.
	IN 1,INARG
	RELEASE 1,
	OUTSTR[ASCIZ"	EOF.
*"]↔	CALL(MKPIMG↑)	;MAKE PERCEIVED IMAGES ON "NOW" CAMERA.
	DAC 1,TMP1#

;KILL UPPER SEGMENT.
	SETZ
	CORE2↔HALT
	POP0J
INARG:0↔0
ENDR INCRE;3/14/73(BGB)----------------------------------------------
END
IO.FAI - EOF.